home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dump_s1r / wad.cls < prev    next >
Text File  |  1998-12-15  |  6KB  |  157 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "clsWad"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
  11. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  12. Option Explicit
  13. Public pCnt As Integer
  14. Public pStrt As Integer
  15. Public pEnd As Integer
  16. Public WadType As String
  17. Public WadLumpCount As Long
  18. Public WadDirStart As Long
  19. Public Canvas As Object
  20. Private LumpColl As New Collection
  21. Public LumpDirectory As New clsLumpDir
  22. Public Property Get ReturnLump(ByVal Index As Long) As clsLumpClass
  23.     Set ReturnLump = LumpColl(Index)
  24. End Property
  25.  
  26. Public Sub Load(FileName As String)
  27.     Dim m_lngLoop As Long
  28.     Dim wHdr As DoomHeader, LumpEntries() As LumpEntry, cLmpByts() As Byte
  29.     Open FileName For Binary As #1
  30.         Get #1, , wHdr
  31.         If Not (wHdr.ASCIIType = "PWAD" Or wHdr.ASCIIType = "IWAD") Then
  32.             MsgBox "Invalid File Header", vbCritical, "Read Error..."
  33.             Close #1
  34.             Exit Sub
  35.         End If
  36.         If wHdr.LumpCount = 0 Then _
  37.             Close #1: GoTo Finished:
  38.         ReDim LumpEntries(1 To wHdr.LumpCount)
  39.         Get #1, wHdr.DirectoryStart + 1, LumpEntries
  40.         For m_lngLoop = 1 To UBound(LumpEntries)
  41.             If Not LumpEntries(m_lngLoop).Length = 0 Then
  42.                 ReDim cLmpByts(1 To LumpEntries(m_lngLoop).Length)
  43.             End If
  44.             Get #1, LumpEntries(m_lngLoop).Offset + 1, cLmpByts
  45.             AddLump cLmpByts, LumpEntries(m_lngLoop).Name, LumpEntries(m_lngLoop).Offset, LumpEntries(m_lngLoop).Length
  46.             LumpDirectory.AddEntry LumpEntries(m_lngLoop).Name, LumpEntries(m_lngLoop).Length, LumpEntries(m_lngLoop).Offset
  47.         Next
  48.     Close #1
  49. Finished:
  50.     WadLumpCount = wHdr.LumpCount
  51.     WadType = wHdr.ASCIIType
  52.     WadDirStart = wHdr.DirectoryStart
  53.     For m_lngLoop = 1 To Count
  54.         If LCase(ReturnLump(m_lngLoop).LumpName) = "s_start" & Chr(0) Or LCase(ReturnLump(m_lngLoop).LumpName) = "ss_start" Then
  55.             pStrt = m_lngLoop
  56.         ElseIf (LCase(ReturnLump(m_lngLoop).LumpName) = "s_end" & String(3, Chr(0)) Or LCase(ReturnLump(m_lngLoop).LumpName) = "ss_end" & String(2, Chr(0))) And pStrt > 0 Then
  57.             pCnt = (m_lngLoop - pStrt - 1)
  58.             pEnd = m_lngLoop
  59.         ElseIf pStrt > 0 And pEnd = 0 Then
  60.             ReturnLump(m_lngLoop).LumpType = Sprite
  61.         ElseIf LCase(ReturnLump(m_lngLoop).LumpName) = "things" & Chr(0) & Chr(0) Then
  62.             ReturnLump(m_lngLoop).LumpType = ThingsEntry
  63.         ElseIf LCase(ReturnLump(m_lngLoop).LumpName) = "segs" & String(4, Chr(0)) Then
  64.             ReturnLump(m_lngLoop).LumpType = SEGSEntry
  65.         ElseIf LCase(ReturnLump(m_lngLoop).LumpName) = "vertexes" Then
  66.             ReturnLump(m_lngLoop).LumpType = VertexesEntry
  67.         ElseIf LCase(ReturnLump(m_lngLoop).LumpName) = "sidedefs" Then
  68.             ReturnLump(m_lngLoop).LumpType = SideDefsEntry
  69.         ElseIf Mid(LCase(ReturnLump(m_lngLoop).LumpName), 1, 1) = "e" And Mid(LCase(ReturnLump(m_lngLoop).LumpName), 3, 1) = "m" Then
  70.             ReturnLump(m_lngLoop).LumpType = Doom1Level
  71.         ElseIf Mid(LCase(ReturnLump(m_lngLoop).LumpName), 1, 3) = "map" Then
  72.             ReturnLump(m_lngLoop).LumpType = Doom2Level
  73.         ElseIf Mid(LCase(ReturnLump(m_lngLoop).LumpName), 1, 2) = "m_" Then
  74.             ReturnLump(m_lngLoop).LumpType = MessageEntry
  75.         End If
  76.     Next
  77.     ReCalc
  78.     LumpDirectory.ReCalc
  79. End Sub
  80.  
  81. Public Sub DeleteLump(ByVal Index As Long)
  82.     LumpColl.Remove Index
  83.     LumpDirectory.RemoveEntry Index
  84. End Sub
  85.  
  86. Public Sub AddLump(LumpBytes() As Byte, LumpName As String, LumpPosition As Long, LumpLength As Long)
  87.     Dim nLmp As New clsLumpClass
  88.     Static LastLump As clsLumpClass
  89.     nLmp.SetBytes LumpBytes
  90.     nLmp.LumpName = LumpName
  91.     nLmp.LumpPosition = LumpPosition
  92.     nLmp.LumpSize = LumpLength
  93.     If LumpLength = 0 Then LumpPosition = 0
  94.     If (LastLump Is Nothing And nLmp.LumpSize <> 0) Then
  95.         nLmp.LumpPosition = 12
  96.     End If
  97.     If LumpLength = 0 Then
  98.         nLmp.LumpType = Label
  99.     Else
  100.         nLmp.LumpType = MiscEntry
  101.     End If
  102.     LumpColl.Add nLmp
  103.     If WadDirStart = 0 Then WadDirStart = 12
  104.     If Not nLmp.LumpPosition + nLmp.LumpSize = 0 Then
  105.         WadDirStart = nLmp.LumpPosition + nLmp.LumpSize
  106.     End If
  107.     Set LastLump = nLmp
  108. End Sub
  109.  
  110. Public Property Get Count() As Long
  111. Count = LumpColl.Count
  112. End Property
  113. Public Sub Save(FileName As String)
  114. On Error Resume Next
  115. Kill FileName
  116. On Error GoTo 0
  117. Dim wHdr As DoomHeader, LumpEntries() As LumpEntry, cLmpByts() As Byte, m_lngLoop As Long
  118. Close
  119. If Count > 0 Then ReDim LumpEntries(1 To Count)
  120. WadLumpCount = Count
  121. wHdr.ASCIIType = WadType
  122. wHdr.DirectoryStart = WadDirStart
  123. wHdr.LumpCount = WadLumpCount
  124.     Open FileName For Binary As #1
  125.         Put #1, , wHdr
  126.         For m_lngLoop = 1 To Count
  127.             ReturnLump(m_lngLoop).LumpBytes cLmpByts
  128.             If LumpDirectory(m_lngLoop).LumpSize > 0 And LumpDirectory(m_lngLoop).LumpPosition > 0 Then
  129.             Put #1, LumpDirectory(m_lngLoop).LumpPosition + 1, cLmpByts
  130.             End If
  131.             LumpEntries(m_lngLoop).Length = LumpDirectory(m_lngLoop).LumpSize
  132.             LumpEntries(m_lngLoop).Name = LumpDirectory(m_lngLoop).LumpName & String(8, Chr(0))
  133.             LumpEntries(m_lngLoop).Offset = LumpDirectory(m_lngLoop).LumpPosition
  134.             If LumpEntries(m_lngLoop).Length = 0 Then LumpEntries(m_lngLoop).Offset = 0
  135.         Next
  136.         If Count > 0 Then
  137.             Put #1, WadDirStart + 1, LumpEntries
  138.         End If
  139.     Close #1
  140. End Sub
  141.  
  142. Public Sub ReCalc()
  143.     Dim DirStart As Long, PlacementStart As Long, m_lngLoop As Long
  144.     DirStart = 12
  145.     PlacementStart = 12
  146.     For m_lngLoop = 1 To Count
  147.         DirStart = DirStart + ReturnLump(m_lngLoop).LumpSize
  148.         If ReturnLump(m_lngLoop).LumpSize > 0 Then
  149.             ReturnLump(m_lngLoop).LumpPosition = PlacementStart
  150.         Else
  151.             ReturnLump(m_lngLoop).LumpPosition = 0
  152.         End If
  153.         PlacementStart = PlacementStart + ReturnLump(m_lngLoop).LumpSize
  154.     Next
  155.     WadDirStart = DirStart
  156. End Sub
  157.